home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Enhanced V270409272001.psc / ApiColourAdjustment.cls < prev    next >
Encoding:
Visual Basic class definition  |  2001-04-05  |  6.5 KB  |  252 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ApiColourAdjustment"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12.  
  13. Private Declare Function GetColorAdjustment Lib "gdi32" (ByVal hdc As Long, lpca As COLORADJUSTMENT) As Long
  14. Private Type COLORADJUSTMENT
  15.     caSize As Integer
  16.     caFlags As Integer
  17.     caIlluminantIndex As Integer
  18.     caRedGamma As Integer
  19.     caGreenGamma As Integer
  20.     caBlueGamma As Integer
  21.     caReferenceBlack As Integer
  22.     caReferenceWhite As Integer
  23.     caContrast As Integer
  24.     caBrightness As Integer
  25.     caColorfulness As Integer
  26.     caRedGreenTint As Integer
  27. End Type
  28. Private Declare Function SetColorAdjustment Lib "gdi32" (ByVal hdc As Long, lpca As COLORADJUSTMENT) As Long
  29.  
  30. Private mParentDC As Long
  31.  
  32. Private mColourAdjustment As COLORADJUSTMENT
  33.  
  34. Public Enum enColourAdjustFlags
  35.      CA_NEGATIVE = &H1
  36.      CA_LOG_FILTER = &H2
  37. End Enum
  38.  
  39. Public Enum enIlluninantIndexes
  40.     ILLUMINANT_DEVICE_DEFAULT = 0
  41.     ILLUMINANT_TUNGSTEN = 1
  42.     ILLUMINANT_NOON_SUNLIGHT = 2
  43.     ILLUMINANT_NTSC_DAYLIGHT = 3
  44.     ILLUMINANT_NORMAL_PRINT = 4
  45.     ILLUMINANT_BOND_PRINT = 5
  46.     ILLUMINANT_STANDARD_DAYLIGHT = 6
  47.     ILLUMINANT_NORTHEN_DAYLIGHT = 7
  48.     ILLUMINANT_FLOURESCENT_LIGHT = 8
  49. End Enum
  50.  
  51. Private Const RGB_GAMMA_MIN    As Long = 2500
  52. Private Const RGB_GAMMA_MAX    As Long = 65000
  53.  
  54. '/* Min and max for ReferenceBlack and ReferenceWhite */
  55. Private Const REFERENCE_WHITE_MIN  As Long = 6000
  56. Private Const REFERENCE_WHITE_MAX  As Long = 10000
  57. Private Const REFERENCE_BLACK_MIN  As Long = 0
  58. Private Const REFERENCE_BLACK_MAX   As Long = 4000
  59. Private Const COLOR_ADJ_MIN    As Long = -100
  60. Private Const COLOR_ADJ_MAX    As Long = 100
  61.  
  62. Public Property Get BlueGamma() As Integer
  63.  
  64.     BlueGamma = mColourAdjustment.caBlueGamma
  65.     
  66. End Property
  67.  
  68. Public Property Let BlueGamma(ByVal newGamma As Integer)
  69.  
  70.     If newGamma < RGB_GAMMA_MIN Then
  71.         newGamma = RGB_GAMMA_MIN
  72.     ElseIf newGamma > RGB_GAMMA_MAX Then
  73.         newGamma = RGB_GAMMA_MAX
  74.     End If
  75.     
  76.     If mColourAdjustment.caBlueGamma <> newGamma Then
  77.        mColourAdjustment.caBlueGamma = newGamma
  78.        Call RefreshColourAdjustment
  79.     End If
  80.     
  81. End Property
  82.  
  83. Public Property Let Brightness(ByVal newValue As Integer)
  84.  
  85.     If newValue < COLOR_ADJ_MIN Then
  86.         newValue = COLOR_ADJ_MIN
  87.     ElseIf newValue > COLOR_ADJ_MAX Then
  88.         newValue = COLOR_ADJ_MAX
  89.     End If
  90.     
  91.     If newValue <> mColourAdjustment.caBrightness Then
  92.         mColourAdjustment.caBrightness = newValue
  93.         Call RefreshColourAdjustment
  94.     End If
  95.     
  96. End Property
  97.  
  98. Public Property Get Brightness() As Integer
  99.  
  100.     Brightness = mColourAdjustment.caBrightness
  101.     
  102. End Property
  103.  
  104. Public Property Let Colourfulness(ByVal newValue As Integer)
  105.  
  106.     If newValue < COLOR_ADJ_MIN Then
  107.         newValue = COLOR_ADJ_MIN
  108.     ElseIf newValue > COLOR_ADJ_MAX Then
  109.         newValue = COLOR_ADJ_MAX
  110.     End If
  111.     
  112.     If newValue <> mColourAdjustment.caColorfulness Then
  113.         mColourAdjustment.caColorfulness = newValue
  114.         Call RefreshColourAdjustment
  115.     End If
  116.  
  117. End Property
  118.  
  119. Public Property Get Colourfulness() As Integer
  120.  
  121. Colourfulness = mColourAdjustment.caColorfulness
  122.  
  123. End Property
  124.  
  125. Public Property Let Contrast(ByVal newContrast As Integer)
  126.  
  127.     If newContrast < COLOR_ADJ_MIN Then
  128.         newContrast = COLOR_ADJ_MIN
  129.     ElseIf newContrast > COLOR_ADJ_MAX Then
  130.         newContrast = COLOR_ADJ_MAX
  131.     End If
  132.     
  133.     If newContrast <> mColourAdjustment.caContrast Then
  134.         mColourAdjustment.caContrast = newContrast
  135.         Call RefreshColourAdjustment
  136.     End If
  137.     
  138. End Property
  139.  
  140. Public Property Get Contrast() As Integer
  141.  
  142.     Contrast = mColourAdjustment.caContrast
  143.     
  144. End Property
  145.  
  146. Public Property Let GreenGamma(ByVal newGamma As Integer)
  147.  
  148.     If newGamma < RGB_GAMMA_MIN Then
  149.         newGamma = RGB_GAMMA_MIN
  150.     ElseIf newGamma > RGB_GAMMA_MAX Then
  151.         newGamma = RGB_GAMMA_MAX
  152.     End If
  153.     
  154.     If mColourAdjustment.caGreenGamma <> newGamma Then
  155.        mColourAdjustment.caGreenGamma = newGamma
  156.        Call RefreshColourAdjustment
  157.     End If
  158.     
  159. End Property
  160.  
  161. Public Property Get GreenGamma() As Integer
  162.  
  163.     GreenGamma = mColourAdjustment.caGreenGamma
  164.     
  165. End Property
  166.  
  167.  
  168. Public Property Let IlluminantIndex(ByVal newIndex As enIlluninantIndexes)
  169.  
  170.     If mColourAdjustment.caIlluminantIndex <> newIndex Then
  171.         mColourAdjustment.caIlluminantIndex = newIndex
  172.         Call RefreshColourAdjustment
  173.     End If
  174.     
  175. End Property
  176.  
  177. Public Property Get IlluminantIndex() As enIlluninantIndexes
  178.  
  179. IlluminantIndex = mColourAdjustment.caIlluminantIndex
  180.  
  181. End Property
  182.  
  183. Public Property Set ParentDC(ByVal newDC As ApiDeviceContext)
  184.  
  185. Dim lRet As Long
  186.  
  187. If newDC.hdc <> mParentDC Then
  188.     mParentDC = newDC.hdc
  189.     lRet = GetColorAdjustment(mParentDC, mColourAdjustment)
  190.     If Err.LastDllError > 0 Then
  191.         Call ReportError(Err.LastDllError, "ApiColourAdjustment:ParentDC", APIDispenser.LastSystemError)
  192.     End If
  193. End If
  194.  
  195. End Property
  196. Public Property Get RedGamma() As Integer
  197.  
  198.     RedGamma = mColourAdjustment.caRedGamma
  199.     
  200. End Property
  201.  
  202. Public Property Let RedGamma(ByVal newGamma As Integer)
  203.  
  204.     If newGamma < RGB_GAMMA_MIN Then
  205.         newGamma = RGB_GAMMA_MIN
  206.     ElseIf newGamma > RGB_GAMMA_MAX Then
  207.         newGamma = RGB_GAMMA_MAX
  208.     End If
  209.     
  210.     If mColourAdjustment.caRedGamma <> newGamma Then
  211.        mColourAdjustment.caRedGamma = newGamma
  212.        Call RefreshColourAdjustment
  213.     End If
  214.     
  215. End Property
  216.  
  217. Public Property Let RedGreenTint(ByVal newTint As Integer)
  218.  
  219.     If newTint < COLOR_ADJ_MIN Then
  220.         newTint = COLOR_ADJ_MIN
  221.     ElseIf newTint > COLOR_ADJ_MAX Then
  222.         newTint = COLOR_ADJ_MAX
  223.     End If
  224.     
  225.     If newTint <> mColourAdjustment.caRedGreenTint Then
  226.         mColourAdjustment.caRedGreenTint = newTint
  227.         Call RefreshColourAdjustment
  228.     End If
  229.     
  230. End Property
  231.  
  232. Public Property Get RedGreenTint() As Integer
  233.  
  234.     RedGreenTint = mColourAdjustment.caRedGreenTint
  235.     
  236. End Property
  237.  
  238. Private Function RefreshColourAdjustment()
  239.  
  240. Dim lRet As Long
  241.  
  242. If mParentDC > 0 Then
  243.     lRet = SetColorAdjustment(mParentDC, mColourAdjustment)
  244.     If Err.LastDllError > 0 Then
  245.         Call ReportError(Err.LastDllError, "ApiColourAdjustment:RefreshColourAdjustment", APIDispenser.LastSystemError)
  246.     End If
  247. End If
  248.  
  249. End Function
  250.  
  251.  
  252.